﻿module InstructionManager

open SVM
open SVMLibrary

let is_reg arg = arg = "REG1" || arg = "REG2" || arg = "REG3" || arg = "REG4"

let is_mem arg = 
  let arg = string_to_list arg
  let length = arg |> List.length
  arg |> List.head = '[' && (List.nth arg (length - 1)) = ']'

let is_const arg = is_reg arg |> not && is_mem arg |> not

let reg_index (r : string) : int =
  let r = string_to_list r
  let length = List.length r
  (List.nth r (length - 1) |> char_to_int) - 1

let memory_index (m : string) (svm : float list * float list * int * bool * (int * int) list) : int =
  let m = string_to_list m
  let (v,_) = m |> List.partition (fun p -> p <> '[' && p <> ']')
  match list_to_string v with
  | "REG1"-> int (get_reg svm 0)
  | "REG2" -> int (get_reg svm 1)
  | "REG3" -> int (get_reg svm 2)
  | "REG4" -> int (get_reg svm 3)
  | _ -> int (list_to_string v)

let are_bool (x1 : float) (x2 : float) = (x1 = 0.0 || x1 = 1.0) && (x2 = 0.0 || x2 = 1.0)

let bool_to_float (b : bool) : float = if b then 1.0 else 0.0

let is_int (f : float) : bool =
  let f_int = int f
  f - (float f_int) = 0.0
  
  

let mov (arg1 : string) 
        (arg2 : string) 
        (svm : float list * float list * int * bool * (int * int) list) : float list * float list * int * bool * (int * int) list =
  let (m,r,pc,e,labels) = svm
  match arg1,arg2 with
  | reg1,reg2 when is_reg arg1 && is_reg arg2 ->
      let x = get_reg svm (reg_index reg2)
      let updated_regs = set_value r x (reg_index reg1)
      (m,updated_regs,pc + 1,e,labels)
  | reg,mem when is_reg arg1 && is_mem arg2 ->
      let x = get_memory svm (memory_index mem svm)
      let updated_regs = set_value r x (reg_index reg)
      (m,updated_regs,pc + 1,e,labels)
  | reg,_const when is_reg arg1 && is_const arg2 ->
      let updated_regs = set_value r (float _const) (reg_index reg)
      (m,updated_regs,pc + 1,e,labels)
  | m1,m2 when is_mem arg1 && is_mem arg2 ->
      let x = get_memory svm (memory_index m2 svm)
      let updated_mem = set_value m x (memory_index m1 svm)
      (updated_mem,r,pc + 1,e,labels)
  | mem,reg when is_mem arg1 && is_reg arg2 ->
      let x = get_reg svm (reg_index reg)
      let updated_mem = set_value m x (memory_index mem svm)
      (updated_mem,r,pc + 1,e,labels)
  | mem,_const when is_mem arg1 && is_const arg2 ->
      let updated_mem = set_value m (float _const) (memory_index mem svm)
      (updated_mem,r,pc + 1,e,labels)
  | _ -> failwith "Invalid instruction format : LOAD"


let _and (arg1 : string) 
         (arg2 : string) 
         (svm : float list * float list * int * bool * (int * int) list) : float list * float list * int * bool * (int * int) list =
  let (m,r,pc,e,labels) = svm

  let and_op (x1 : float) (x2 : float) : float =
    match x1,x2 with
    | 1.0,1.0 -> 1.0
    | _ -> 0.0

  let (.&&) (x1 : float) (x2 : float) : float = and_op x1 x2

  match arg1,arg2 with
  | reg1,reg2 when is_reg arg1 && is_reg arg2 ->
      let x1 = get_reg svm (reg_index reg1)
      let x2 = get_reg svm (reg_index reg2)
      if (are_bool x1 x2 |> not) then
        failwith "AND ERROR: Arguments are not boolean"
      else
        let res = x1 .&& x2
        let updated_reg = set_value r res (reg_index reg1)
        (m,updated_reg,pc + 1,e,labels)
  | reg,mem when is_reg arg1 && is_mem arg2 ->
      let x1 = get_reg svm (reg_index reg)
      let x2 = get_memory svm (memory_index mem svm)
      if (are_bool x1 x2 |> not) then
        failwith "AND ERROR: Arguments are not boolean"
      else
        let res = x1 .&& x2
        let updated_reg = set_value r res (reg_index reg)
        (m,updated_reg,pc + 1,e,labels)
  | reg,_const when is_reg arg1 && is_const arg2 ->
      let x = get_reg svm (reg_index reg)
      let _const = (float _const)
      if (are_bool x _const |> not) then
        failwith "AND ERROR: Arguments are not boolean"
      else
        let res = x .&& _const
        let updated_reg = set_value r res (reg_index reg)
        (m,updated_reg,pc + 1,e,labels)
  | _ -> failwith "Invalid instruction format : AND"

let _or (arg1 : string) 
        (arg2 : string) 
        (svm : float list * float list * int * bool * (int * int) list) : float list * float list * int  * bool * (int * int) list =
  let (m,r,pc,e,labels) = svm

  let or_op (x1 : float) (x2 : float) : float =
    match x1,x2 with
    | 0.0,0.0 -> 0.0
    | _ -> 1.0

  let (.||) (x1 : float) (x2 : float) : float = or_op x1 x2

  match arg1,arg2 with
  | reg1,reg2 when is_reg arg1 && is_reg arg2 ->
      let x1 = get_reg svm (reg_index reg1)
      let x2 = get_reg svm (reg_index reg2)
      if (are_bool x1 x2 |> not) then
        failwith "OR ERROR: Arguments are not boolean"
      else
        let res = x1 .|| x2
        let updated_reg = set_value r res (reg_index reg1)
        (m,updated_reg,pc + 1,e,labels)
  | reg,mem when is_reg arg1 && is_mem arg2 ->
      let x1 = get_reg svm (reg_index reg)
      let x2 = get_memory svm (memory_index mem svm)
      if (are_bool x1 x2 |> not) then
        failwith "OR ERROR: Arguments are not boolean"
      else
        let res = x1 .|| x2
        let updated_reg = set_value r res (reg_index reg)
        (m,updated_reg,pc + 1,e,labels)
  | reg,_const when is_reg arg1 && is_const arg2 ->
      let x = get_reg svm (reg_index reg)
      let _const = (float _const)
      if (are_bool x _const |> not) then
        failwith "OR ERROR: Arguments are not boolean"
      else
        let res = x .|| _const
        let updated_reg = set_value r res (reg_index reg)
        (m,updated_reg,pc + 1,e,labels)
  | _ -> failwith "Invalid instruction format : OR"

let _not  (arg1 : string) 
          (arg2 : string) 
          (svm : float list * float list * int * bool * (int * int) list) : float list * float list * int * bool * (int * int) list =
  let (m,r,pc,e,labels) = svm

  let not_op (x : float) : float =
    match x with
    | 0.0 -> 1.0
    | _ -> 0.0

  let (!) (x : float) : float = not_op x

  match arg1,arg2 with
  | reg1,reg2 when is_reg arg1 && is_reg arg2 ->
      let x1 = get_reg svm (reg_index reg1)
      let x2 = get_reg svm (reg_index reg2)
      if (are_bool x1 x2 |> not) then
        failwith "NOT ERROR: Arguments are not boolean"
      else
        let res = !x2
        let updated_reg = set_value r res (reg_index reg1)
        (m,updated_reg,pc + 1,e,labels)
  | reg,mem when is_reg arg1 && is_mem arg2 ->
      let x1 = get_reg svm (reg_index reg)
      let x2 = get_memory svm (memory_index mem svm)
      if (are_bool x1 x2 |> not) then
        failwith "NOT ERROR: Arguments are not boolean"
      else
        let res = !x2
        let updated_reg = set_value r res (reg_index reg)
        (m,updated_reg,pc + 1,e,labels)
  | reg,_const when is_reg arg1 && is_const arg2 ->
      let x = get_reg svm (reg_index reg)
      let _const = (float _const)
      if (are_bool x _const |> not) then
        failwith "NOT ERROR: Arguments are not boolean"
      else
        let res = !_const
        let updated_reg = set_value r res (reg_index reg)
        (m,updated_reg,pc + 1,e,labels)
  | _ -> failwith "Invalid instruction format : NOT"

let arith_op 
  (arg1 : string) 
  (arg2 : string) 
  (svm : float list * float list * int * bool * (int * int) list) 
  (op : float -> float -> float) : float list * float list * int * bool * (int * int) list =

  let (m,r,pc,e,labels) = svm
  match arg1,arg2 with
  | reg1,reg2 when is_reg arg1 && is_reg arg2 ->
      let x1 = get_reg svm (reg_index reg1)
      let x2 = get_reg svm (reg_index reg2)
      let res = op x1 x2
      let updated_reg = set_value r res (reg_index reg1)
      (m,updated_reg,pc + 1,e,labels)
  | reg,mem when is_reg arg1 && is_mem arg2 ->
      let x1 = get_reg svm (reg_index reg)
      let x2 = get_memory svm (memory_index mem svm)
      let res = op x1 x2
      let updated_reg = set_value r res (reg_index reg)
      (m,updated_reg,pc + 1,e,labels)
  | reg,_const when is_reg arg1 && is_const arg2 ->
      let x = get_reg svm (reg_index reg)
      let _const = (float _const)
      let res = op x _const
      let updated_reg = set_value r res (reg_index reg)
      (m,updated_reg,pc + 1,e,labels)
  | _ -> failwith "Invalid arithmetic instruction format"

let comp_op
  (arg1 : string) 
  (arg2 : string) 
  (svm : float list * float list * int * bool * (int * int) list) 
  (op : float -> float -> bool) : float list * float list * int * bool * (int * int) list =

  let (m,r,pc,e,labels) = svm
  match arg1,arg2 with
  | reg1,reg2 when is_reg arg1 && is_reg arg2 ->
      let x1 = get_reg svm (reg_index reg1)
      let x2 = get_reg svm (reg_index reg2)
      let res = op x1 x2 |> bool_to_float
      let updated_reg = set_value r res (reg_index reg1)
      (m,updated_reg,pc + 1,e,labels)
  | reg,mem when is_reg arg1 && is_mem arg2 ->
      let x1 = get_reg svm (reg_index reg)
      let x2 = get_memory svm (memory_index mem svm)
      let res = op x1 x2 |> bool_to_float
      let updated_reg = set_value r res (reg_index reg)
      (m,updated_reg,pc + 1,e,labels)
  | reg,_const when is_reg arg1 && is_const arg2 ->
      let x = get_reg svm (reg_index reg)
      let _const = (float _const)
      let res = op x _const |> bool_to_float
      let updated_reg = set_value r res (reg_index reg)
      (m,updated_reg,pc + 1,e,labels)
  | _ -> failwith "Invalid arithmetic instruction format"

let jump (arg : string) (svm : float list * float list * int * bool * (int * int) list) : float list * float list * int * bool * (int * int) list =
  let (m,r,pc,e,labels) = svm

  let jump_f (x : float) (svm : float list * float list * int * bool * (int * int) list) =
    let (_,_,_,_,labels) = svm

    if is_int x then
      let label_index =
        labels |> List.filter(fun (l,_) -> l = (int x)) |> List.head |> snd
      (m,r,label_index + 1,e,labels)
    else
      failwith "Fractional argument in jump instruction"

  match arg with
  | reg when is_reg arg ->
      let x = get_reg svm (reg_index reg)
      jump_f x svm
  | _const when is_const arg ->
      let _const = float _const
      jump_f _const svm
  | _ -> failwith "Invalid jump instruction format"

let conditional_jump (arg1 : string) 
                     (arg2 : string) 
                     (svm : float list * float list * int * bool * (int * int) list) : float list * float list * int * bool * (int * int) list =
  
  let (m,r,pc,e,labels) = svm
  
  let jump_f (x1 : float) (x2 : float) (svm : float list * float list * int * bool *  (int * int) list) =
    let (_,_,_,_,labels) = svm
    if is_int x1 then
      if x2 = 1.0 then
        let label_index =
          labels |> List.filter(fun (l,_) -> l = (int x1)) |> List.head |> snd
        (m,r,label_index + 1,e,labels)
      else
        (m,r,pc + 1,e,labels)
    else
      failwith "Fractional argument in jump instruction"

  match arg1,arg2 with
  | reg,mem when is_reg arg1 && is_mem arg2 ->
      let x1 = get_reg svm (reg_index reg)
      let x2 = get_memory svm (memory_index mem svm)
      jump_f x1 x2 svm
  
  | reg1,reg2 when is_reg arg1 && is_reg arg2 ->
      let x1 = get_reg svm (reg_index reg1)
      let x2 = get_reg svm (reg_index reg2)
      jump_f x1 x2 svm

  | _const,reg when is_const arg1 && is_reg arg2 ->
      let _const = float _const
      let x = get_reg svm (reg_index reg)
      jump_f _const x svm
        

  | _ -> failwith "Invalid conditional jump instruction format"

let label (arg : string)
          (svm : float list * float list * int * bool * (int * int) list) : float list * float list * int * bool * (int * int) list =

  let (m,r,pc,e,labels) = svm

  match arg with
  | _const when is_const arg ->
      let _const = (float _const)
      if is_int _const then
        if labels |> Seq.exists (fun (l,_) -> l = (int _const)) |> not then
          (m,r,pc + 1,e,((int _const),pc) :: labels)
        else
          (m,r,pc + 1,e,labels)
      else
        failwith "Fractional argument in label instruction"
  | _ -> failwith "Invalid label instruction format"



let _end (svm : float list * float list * int * bool * (int * int) list) : float list * float list * int * bool * (int * int) list =
  let (m,r,pc,e,labels) = svm
  (m,r,pc + 1,true,labels)
      

